home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / utils / frame-icon.el.z / frame-icon.el
Encoding:
Text File  |  1998-05-21  |  6.7 KB  |  217 lines
  1. ;; frame-icon.el - set up mode-specific icons for each frame under XEmacs
  2.  
  3. ;; Author: Michael Lamoureux <lamour@engin.umich.edu>
  4. ;; Keywords: lisp, extensions
  5. ;; date created: 8/3/93
  6.  
  7. ;; This file is part of XEmacs.
  8.  
  9. ;; XEmacs is free software; you can redistribute it and/or modify it
  10. ;; under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; XEmacs is distributed in the hope that it will be useful, but
  15. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;; General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  21. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  22. ;; 02111-1307, USA.
  23.  
  24. ;;; Synched up with: Not in FSF.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; Modified by Bob Weiner <weiner@infodock.com>, 1/13/94
  29. ;;   Handle XEmacs 19.8 pixmaps properly. 
  30. ;;   Also added in more mode settings and added many new bitmaps.
  31. ;;   Renamed from icon.el to frame-icon.el.
  32. ;;   Made all definitions start with the same prefix, 'icon-'.
  33. ;;   Added a provide clause.
  34. ;;
  35. ;; Modified by Bob Weiner, 2/24/95, to handle XEmacs 19.12.
  36. ;;   Added set of unmap-frame-hook.
  37. ;;
  38. ;; Modified by Bob Weiner, 7/17/95, to handle XEmacs 19.12.
  39. ;;   Changed to use new image-handling protocols and added backwards
  40. ;;   compatibility functions for new image functions.
  41. ;;
  42. ;; Modified by Bob Weiner, 7/18/95.
  43. ;;   Added icon-suffix variable so can use .xbm or .xpm icons.
  44. ;;
  45. ;; Most Icons were extracted from: /export.lcs.mit.edu:/contrib/AIcons
  46. ;;
  47.  
  48. ;;; Code:
  49.  
  50. (defvar icon-directory (locate-data-directory "frame-icon")
  51.   "Directory of icons used by frame-icon.el.")
  52.  
  53. (defvar icon-suffix ".xbm"
  54.   "Must be .xbm or .xpm, depending on the format of the icons in icon-directory.")
  55.  
  56. (defconst icon-mode-alist
  57.   '(
  58.     (default . "question")
  59.     ;; For testing
  60.     (fundamental-mode . "match")
  61.     ;;
  62.     (archie-mode . "archie")
  63.     (asm-mode . "nuke")
  64.     (bbdb-mode . "eye")
  65.     (bookmark-menu-mode . "finder")
  66.     (Buffer-menu-mode . "help")
  67.     (c++-mode . "c++")
  68.     (c++-c-mode . "escherknot")
  69.     (c-mode . "c")
  70.     (awk-mode . "escherknot")
  71.     (cvs-mode . "tree")
  72.     (f90-mode . "wizard")
  73.     (xrdb-mode . "RIP")
  74.     ;;
  75.     (calc-edit-mode . "cray")
  76.     (calc-keypad . "cray")
  77.     (calc-mode . "cray")
  78.     (calc-trail-mode . "cray")
  79.     (MacEdit-mode . "cray")
  80.     ;;
  81.     (calendar-mode . "calendar")
  82.     (comint-mode . "terminal")
  83.     (perl-mode . "perl")
  84.     (csh-mode . "manpage2")
  85.     (db-edit-mode . "filing")
  86.     (db-view-mode . "filing")
  87.     (dired-mode . "filing")
  88.     (doctor-mode . "ying-yang-48")
  89.     (edit-faces-mode  . "eye")
  90.     (Edit-options-mode . "swissknife")
  91.     (emacs-lisp-mode . "elisp")
  92.     (fortran-mode    . "RIP")
  93.     (gdb-mode        . "bug-48")
  94.     (gud-mode        . "bug-48")
  95.     (gnus-article-mode . "news")
  96.     (gnus-group-mode . "news")
  97.     (gnus-summary-mode . "news")
  98.     (gopher-mode . "gopher")
  99.     (html-mode . "xmosaic")
  100.     (indented-text-mode . "page")
  101.     (Info-mode . "help")
  102.     (java-mode . "coffee")
  103.     (kotl-mode . "kotl")
  104.     (lisp-interaction-mode . "swissknife")
  105.     (lisp-mode . "lisp")
  106.     (lock-mode . "termlock")
  107.     (mail-mode . "scroll2")
  108.     (Manual-mode . "manpage")
  109.     (man-mode . "manpage")
  110.     (news-reply-mode . "match")
  111.     (outline-mode . "outline")
  112.     (perl-mode . "perl")
  113.     (edit-picture . "splat")
  114.     (pm-fdr-mode . "mail")
  115.     (pm-group-mode . "news")
  116.     (pm-msg-edit-mode . "mail")
  117.     (pm-msgsumm-mode . "mail")
  118.     (pm-mode . "mail")
  119.     (rdb-mode . "question")
  120.     (rmail-mode . "mail")
  121.     (rmail-edit-mode . "mail")
  122.     (rmail-summary-mode . "mail")
  123.     (scheme-interaction-mode . "swissknife")
  124.     (scheme-mode . "lisp")
  125.     (shell-mode . "terminal")
  126.     (sm-manual-mode . "manpage")
  127.     (sql-mode . "sql")
  128.     (tcl-mode . "radioactive")
  129.     (telnet-mode . "rlogin")
  130.     (texinfo-mode . "texinfo")
  131.     (text-mode . "page")
  132.     (unix-apropos-mode . "manpage")
  133.     (ups-mode . "hourglass") ; process listing mode
  134.     (vi-mode   . "stopsign")
  135.     (vip-mode   . "stopsign")
  136.     (vkill-mode . "load")
  137.     (vrml-mode . "drawing")
  138.     (vm-mode . "scroll2")
  139.     (vm-summary-mode . "scroll2")
  140.     (w3-mode . "world")
  141.     (waisq-mode . "library")
  142.     (wordstar-mode . "words")
  143.     (wrolo-mode . "phone")
  144.     ;;
  145.     (ams-tex-mode . "tex-48")
  146.     (foiltex-mode . "tex-48")
  147.     (latex-mode . "tex-48")
  148.     (LaTeX-mode . "tex-48")
  149.     (plain-tex-mode . "tex-48")
  150.     (plain-TeX-mode . "tex-48")
  151.     (slitex-mode . "tex-48")
  152.     (tex-mode . "tex-48")
  153.     )
  154.   "Alist of (major-mode . non-suffixed-icon-file-name) elements.
  155. Used to set frame icons based upon the current major mode.
  156. For use with icon-set-frame.  See also the variable, 'icon-suffix'.")
  157.  
  158. (or (fboundp 'image-instance-p) (fset 'image-instance-p 'pixmapp))
  159. (or (fboundp 'image-instance-file-name)
  160.     (fset 'image-instance-file-name 'pixmap-file-name))
  161. (or (fboundp 'make-glyph) (fset 'make-glyph 'make-pixmap))
  162.  
  163. (defun icon-set-frame (iconified-frame)
  164.   "Set icon for selected frame according to the values in icon-mode-alist."
  165.   (save-excursion
  166.     (if (framep iconified-frame)
  167.     (select-frame iconified-frame))
  168.     (let* ((icon-sym (intern (concat "icon-" (symbol-name major-mode))))
  169.        (pix (and (boundp icon-sym) (symbol-value icon-sym)))
  170.        (image (or (cdr (assq major-mode icon-mode-alist))
  171.               (cdr (assq 'default icon-mode-alist))))
  172.        (image-file (expand-file-name (concat image icon-suffix)
  173.                      icon-directory)))
  174.       (cond ((and (image-instance-p pix)
  175.           (equal image-file (image-instance-file-name pix)))
  176.          nil)
  177.         (t
  178.          ;; Ensure we don't create a copy of a pixmap already in
  179.          ;; icon-list due to use in a different major-mode.
  180.          (setq pix (set icon-sym
  181.                 (car (delq
  182.                   nil
  183.                   (mapcar
  184.                    (function
  185.                     (lambda (pixmap)
  186.                       (if (equal (image-instance-file-name
  187.                           pixmap)
  188.                          image-file)
  189.                       pixmap)))
  190.                    icon-list)))))
  191.          ;; If pix is nil, there was no entry in icon-list, so create a
  192.          ;; new one.
  193.          (or (image-instance-p pix)
  194.          (setq pix 
  195.                (glyph-image-instance
  196.             (set icon-sym (make-glyph image-file)))
  197.                icon-list (cons pix icon-list)))))
  198.       (x-set-frame-icon-pixmap
  199.        (if (framep iconified-frame)
  200.        iconified-frame
  201.      ;; unpatched XEmacs 19.6
  202.      (selected-frame))
  203.        pix))))
  204.  
  205. (defvar icon-list nil
  206.   "List of existing pixmap objects used as frame icons by frame-icon.el.")
  207.  
  208. ;; Hook in so icons will be selected at iconify time
  209. (if (string-match "XEmacs" emacs-version)
  210.     (add-hook 'unmap-frame-hook 'icon-set-frame) ;; XEmacs 19.12
  211.   (add-hook 'unmap-screen-hook 'icon-set-frame)) ;; Lemacs 19.10
  212.  
  213.  
  214. (provide 'frame-icon)
  215.  
  216. ;;; frame-icon.el ends here
  217.